home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0128_Text Interface Unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  4.1 KB  |  194 lines
  1. unit iface; { INTERFACE, for creating TEXT interfaces. }
  2.  
  3. INTERFACE
  4.  
  5. uses crt,dos,link,txtwin;
  6.      { NOTE : Link in POINTERS.SWG
  7.               txtwin in TEXTWNDW.SWG }
  8.  
  9. const
  10.   kbnull=#0;
  11.   kbesc=#27;
  12.   kbpgup=#73;
  13.   kbpgdown=#81;
  14.   kbhome=#71;
  15.   kbend=#79;
  16.   kbleft=#75;
  17.   kbright=#77;
  18.   kbup=#72;
  19.   kbdown=#80;
  20.   kbf1=#59;
  21.   kbenter=#13;
  22.   kbdel=#83;
  23.   kbbackspace=#8;
  24.   colseg:word=$b800;
  25. type
  26.   tchok=set of char;
  27.  
  28. function  getkey(const s:string;const chok:tchok):char;
  29. function  getstring(col,x,y,max:byte;legalch:tchok):string;
  30. procedure xorbar(x1,x2,y:word;c:byte);
  31. function  selectbar(xp,yp,x2,num,col,ystart:byte;abort:boolean):byte;
  32. function  selectfile(wildcard:string;x,y,col:byte;abort:boolean):string;
  33.  
  34. IMPLEMENTATION
  35.  
  36. var
  37.   dirlink:plink;
  38.   dirinfo:searchrec;
  39.  
  40. function getkey(const s:string;const chok:tchok):char;
  41. var ch:char;
  42. begin
  43.   write(s);
  44.   repeat
  45.     ch:=readkey;
  46.   until(ch in chok);
  47.   getkey:=ch;
  48. end;
  49.  
  50. function getstring(col,x,y,max:byte;legalch:tchok):string;
  51. var
  52.   ch:char;
  53.   input,temp:string;
  54.   oldcol,i,xpos,ypos:byte;
  55.   hoejre,venstre:string[23];
  56. begin
  57.   getstring:='';
  58.   gotoxy(x,y);
  59.   oldcol:=textattr;
  60.   textattr:=col;
  61.   ch:=#0;
  62.   input:=''; hoejre:=''; venstre:='';
  63.   xpos:=x; ypos:=y;
  64.   repeat
  65.     gotoxy(xpos,ypos);
  66.     venstre:=copy(input,1,xpos-13);
  67.     hoejre:=copy(input,xpos-12,36-xpos);
  68.     repeat
  69.       ch:=readkey;
  70.     until(ch in legalch);
  71.     if(ch=kbnull)then
  72.     begin
  73.       ch:=readkey;
  74.       case ch of
  75.         kbhome:xpos:=x;
  76.         kbleft:if(xpos>x)then dec(xpos);
  77.         kbright:if(xpos<ord(input[0])+x)then inc(xpos);
  78.         kbdel:begin
  79. {                hoejre:=copy(hoejre,2,length(hoejre)-1);
  80.                 input:=venstre+hoejre;}
  81.                 delete(input,(xpos-x)+1,1);
  82.               end;
  83.         kbend:begin
  84.                 xpos:=ord(input[0])+x;
  85.               end;
  86.       end;
  87.     end else if(ord(input[0])<max)and(ch<>kbbackspace)and
  88.                (ch<>kbenter)then
  89.     begin
  90. {      input:=venstre+ch+hoejre;     (* indsæt karakter *)}
  91.       temp:=copy(input,1,(xpos-x));
  92.       temp:=temp+ch;
  93.       temp:=temp+copy(input,(xpos-x)+1,length(input));
  94.       input:=temp;
  95.       write(ch);
  96.       inc(xpos);
  97.     end;
  98.     if(ch=kbbackspace)then
  99.     begin
  100.       if(ord(input[0])>0)then
  101.       begin
  102.         if(xpos>x)then dec(xpos);
  103.         delete(venstre,(xpos-x)+1,1);
  104.         gotoxy(xpos,ypos);
  105.         write(' ');
  106.         input:=venstre+hoejre;
  107.       end;
  108.     end;
  109.     gotoxy(x,y); clreol; write(input);
  110.   until(ch=kbenter)or(ch=kbesc);
  111.   if(ch=kbesc)then
  112.   begin
  113.     getstring:='';
  114.     exit;
  115.   end;
  116.   textattr:=oldcol;
  117.   getstring:=input;
  118. end;
  119.  
  120. procedure xorbar(x1,x2,y:word;c:byte); assembler;
  121. asm
  122.   dec [y]
  123.   push colseg
  124.   pop es
  125.   mov di,[y]
  126.   mov bx,di
  127.   shl di,6
  128.   shl bx,4
  129.   add di,bx
  130.   add di,[x1]
  131.   shl di,1
  132.   dec di
  133.   mov cx,[x2]
  134.   sub cx,[x1]
  135.   inc cx
  136.   @@loop:
  137.     mov al,[c]
  138.     xor es:[di],al
  139.     add di,2
  140.     dec cx
  141.     jnz @@loop
  142. end;
  143.  
  144. function selectbar(xp,yp,x2,num,col,ystart:byte;abort:boolean):byte;
  145. var
  146.   ch:char;
  147.   y,oy:byte;
  148.   done:boolean;
  149. begin
  150.   selectbar:=0;
  151.   oy:=255; y:=ystart;
  152.   if(y>num)then exit;
  153.   done:=false;
  154.   repeat
  155.     if(y<>oy)then
  156.     begin
  157.       if(oy<>255)then xorbar(xp,x2,pred(oy+yp),col);
  158.       xorbar(xp,x2,pred(y+yp),col);
  159.       oy:=y;
  160.     end;
  161.     ch:=readkey;
  162.     if(ch=kbnull)then
  163.     begin
  164.       ch:=readkey;
  165.       case ch of
  166.         kbleft,kbup:if(y>1)then dec(y);
  167.         kbright,kbdown:if(y<num)then inc(y);
  168.       end;
  169.     end else
  170.     case ch of
  171.       kbenter:begin selectbar:=succ(y-yp); done:=true; end;
  172.       kbesc:begin if(abort)then done:=true; end;
  173.     end;
  174.   until(done);
  175. end;
  176.  
  177. function selectfile(wildcard:string;x,y,col:byte;abort:boolean):string;
  178. var
  179.   wx1,wy1,wx2,wy2:byte; { Window dimensions. }
  180. begin
  181.   inilink(dirlink);
  182.   selectfile:='';
  183.   findfirst(wildcard,archive,dirinfo);
  184.   if(dirinfo.name='')then exit;
  185.   while(doserror=0)do
  186.   begin
  187.     addlink2(dirlink,dirinfo.name);
  188.     findnext(dirinfo);
  189.   end;
  190.   writeln(numlinks(dirlink));
  191.   killink(dirlink);
  192. end;
  193.  
  194. end.